home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / pc_board / cal14s24.zip / CALLS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-29  |  72KB  |  2,571 lines
  1.  
  2. {$M 50000,30000,500000}  {Stack, minheap, maxheap}
  3.  
  4. {$V-}    {Relax string rules}
  5. {$S-}    {Stack testing}
  6. {$R-}    {Range checks}
  7. {$L+}    {Local debug info}
  8. {$D+}    {Global debug info}
  9.  
  10. program caller_log_report;
  11.  
  12. uses Dos, Qread, ansiCrt, MdosIO, openShare;
  13.  
  14.  
  15. {                 PCBoard Call Analyzer Ver. 11.7  02/19/87                }
  16. {                                                                          }
  17. {       PCBoard Call Analyzer written by Warren Lauzon of Phoenix AZ       }
  18. {                 Phoenix Techline PCBoard   602-936-3058                  }
  19. {                                                                          }
  20. {      (updated for PCBoard 11.8 and PCB ProDOOR, S.H.Smith, 09/02/87)     }
  21. {              (updated for PCBoard 14.1 S.H.Smith, 08/02/89)              }
  22.  
  23.  
  24. const
  25.    version     = '14s24';
  26.    reldate     = '10-29-92';
  27.    pcbversion  = 'For PCBoard v14.x';
  28.  
  29. type
  30.    anystring   = string[80];
  31.    FileStr     = string[64]; {array[1..64] of char;}
  32.    char64      = array[1..64] of char;
  33.    ItemNameStr = string[20];
  34.  
  35.    ItemPointer = ^ItemList;
  36.    ItemList    = record
  37.                      name:    ItemNameStr;
  38.                      count:   real;
  39.                      next:    ItemPointer;
  40.                end;
  41.  
  42.    FilePointer = ^FileRec;
  43.    FileRec     = record
  44.                      name:    string[16];
  45.                      count:   longint;
  46.                      size:    longint;
  47.                      higher:  FilePointer;
  48.                      lower:   FilePointer;
  49.                end;
  50.  
  51.    ProtocolRecord = record
  52.                      Code:       char;
  53.                      Name:       string[20];
  54.                      Uploads:    longint; {count of uploads}
  55.                      UpTime:     real; {time spent uploading}
  56.                      UpIdeal:    real; {ideal time if 100% efficient}
  57.                      Downloads:  longint;
  58.                      DownTime:   real;
  59.                      DownIdeal:  real;
  60.                end;
  61.  
  62. const
  63.    OldProtocolCount = 27;
  64.    ProtocolCount = 56;
  65.    Protocol:  array[1..ProtocolCount] of ProtocolRecord = (
  66.       (Code:  'A'; Name:  'ASCII'),
  67.       (Code:  'B'; Name:  'B'),
  68.       (Code:  'C'; Name:  'CRC Xmodem'),
  69.       (Code:  'D'; Name:  'D'),
  70.       (Code:  'E'; Name:  'E'),
  71.       (Code:  'F'; Name:  'Full Flow'),
  72.       (Code:  'G'; Name:  'Ymodem-G (dsz)'),
  73.       (Code:  'H'; Name:  'HS/Link'),
  74.       (Code:  'I'; Name:  'I'),
  75.       (Code:  'J'; Name:  'Jmodem'),
  76.       (Code:  'K'; Name:  'Kermit'),
  77.       (Code:  'L'; Name:  'Sysop (Local)'),
  78.       (Code:  'M'; Name:  'MobyTurbo Zmodem'),
  79.       (Code:  'N'; Name:  'N'),
  80.       (Code:  'O'; Name:  '1K-Xmodem'),
  81.       (Code:  'P'; Name:  'P'),
  82.       (Code:  'Q'; Name:  'Q'),
  83.       (Code:  'R'; Name:  'R'),
  84.       (Code:  'S'; Name:  'S'),
  85.       (Code:  'T'; Name:  'T'),
  86.       (Code:  'U'; Name:  'U'),
  87.       (Code:  'V'; Name:  'V'),
  88.       (Code:  'W'; Name:  'WXmodem'),
  89.       (Code:  'X'; Name:  'Xmodem'),
  90.       (Code:  'Y'; Name:  'Ymodem'),
  91.       (Code:  'Z'; Name:  'Zmodem'),
  92.  
  93.       (Code:  '0'; Name:  '0'),
  94.       (Code:  '1'; Name:  '1'),
  95.       (Code:  '2'; Name:  '2'),
  96.       (Code:  '3'; Name:  '3'),
  97.       (Code:  '4'; Name:  '4'),
  98.       (Code:  '5'; Name:  '5'),
  99.       (Code:  '6'; Name:  '6'),
  100.       (Code:  '7'; Name:  '7'),
  101.       (Code:  '8'; Name:  '8'),
  102.       (Code:  '9'; Name:  '9'),
  103.       (Code:  '!'; Name:  '!'),
  104.       (Code:  '@'; Name:  '@'),
  105.       (Code:  '#'; Name:  '#'),
  106.       (Code:  '$'; Name:  '$'),
  107.       (Code:  '%'; Name:  '%'),
  108.       (Code:  '^'; Name:  '^'),
  109.       (Code:  '&'; Name:  '&'),
  110.       (Code:  '*'; Name:  '*'),
  111.       (Code:  '+'; Name:  '+'),
  112.       (Code:  '-'; Name:  '-'),
  113.       (Code:  '<'; Name:  '<'),
  114.       (Code:  '>'; Name:  '>'),
  115.       (Code:  '/'; Name:  '/'),
  116.       (Code:  '['; Name:  '['),
  117.       (Code:  ']'; Name:  ']'),
  118.       (Code:  '{'; Name:  '{'),
  119.       (Code:  '}'; Name:  '}'),
  120.       (Code:  '`'; Name:  '`'),
  121.       (Code:  '~'; Name:  '~'),
  122.  
  123.       (Code:  '?'; Name:  'Others')  {must be last}
  124.    );
  125.  
  126.  
  127. {$i stoupper.inc}
  128.  
  129. (* -------------------------------------------------------- *)
  130. const
  131.    red:        string[7] = #27'[1;31m';
  132.    green:      string[7] = #27'[1;32m';
  133.    yellow:     string[7] = #27'[1;33m';
  134.    blue:       string[7] = #27'[1;34m';
  135.    magenta:    string[7] = #27'[1;35m';
  136.    cyan:       string[7] = #27'[0;36m';
  137.    white:      string[7] = #27'[1;37m';
  138.    gray:       string[7] = #27'[0m';
  139.  
  140.  
  141.  
  142. (* -------------------------------------------------------- *)
  143. const
  144.    nodes:         longint = 1;   {number of nodes}
  145.    logsize:       word = 0;
  146.    UsedMinutes:   longint = 0;   {time used, minutes}
  147.    Hours:         longint = 0;   {time used, hours}
  148.    stuff:         longint = 0;
  149.    runtime:       real = 0;      {how long it takes the program to run}
  150.    Endtime:       real = 0;      {End time for program start}
  151.  
  152.    viewmember:    longint = 0;   {number of zip member textviews}
  153.    extmember:     longint = 0;   {number of zip member extracts}
  154.    repacks:       longint = 0;   {number of re-ziphive runs}
  155.    testexec:      longint = 0;   {number of ziphives tested}
  156.    viewexec:      longint = 0;   {number of 'view executed'}
  157.    backdos:       longint = 0;   {number of times back from dos}
  158.    batchs:        longint = 0;   {number of batch transfers}
  159.    baud:          word = 0;      {current caller's baud rate}
  160.    clevel:        anystring = '';{current caller's security leve]}
  161.    blts:          longint = 0;   {bulletins read}
  162.    caller:        longint = 0;   {number of callers}
  163.    comments:      longint = 0;   {number of comments}
  164.    dirscan:       longint = 0;   {number of DIR scans}
  165.    DOORs:         longint = 0;   {number of DOORs opened}
  166.    DosTimes:      longint = 0;   {how many times dropped to DOS}
  167.    down:          longint = 0;   {number of downloads}
  168.    d_abort:       longint = 0;   {number of download aborts}
  169.    events:        longint = 0;   {event timer activated}
  170.    even_parity:   longint = 0;   {7E callers}
  171.    free_down:     longint = 0;   {free downloads}
  172.    graphics:      longint = 0;   {graphics callers}
  173.    joins:         longint = 0;   {number of conference joins}
  174.    kills:         longint = 0;   {messages killed}
  175.    lockouts:      longint = 0;   {Automatic lockouts done}
  176.    mssgs:         longint = 0;   {messages left}
  177.    Qmssgs:        longint = 0;   {Qmail messages left}
  178.    Mmssgs:        longint = 0;   {Markmail messages left}
  179.    new_guys:      longint = 0;   {new users registered}
  180.    non_graphics:  longint = 0;   {non-graphics callers}
  181.    sysop_paged:   longint = 0;   {sysop pages}
  182.    pwfail:        longint = 0;   {password fails}
  183.    question:      longint = 0;   {main questionnaire answered}
  184.    refused:       longint = 0;   {refused to register}
  185.    secviol:       longint = 0;   {security violations}
  186.    start_time:    real = 0;      {0 time for program start}
  187.    sysop_local:   longint = 0;   {local sysop sessions}
  188.    sysop_remote:  longint = 0;   {remote sysop sessions}
  189.    tcan:          longint = 0;   {number of trashcan name attempts}
  190.    time_limit:    longint = 0;   {daily time limit exceeded}
  191.    UniqFiles:     longint = 0;   {number of dIfferent files}
  192.    up:            longint = 0;   {number of uploads}
  193.    u_abort:       longint = 0;   {number of upload aborts}
  194.    zipmail:       longint = 0;   {number of ARCM runs}
  195.    msgcount:      longint = 0;   {number of ARCM messges}
  196.    invalids:      longint = 0;   {number of invalid uploads}
  197.    schat:         longint = 0;   {sysop chat initiated}
  198.    nchat:         longint = 0;   {node chat initiated}
  199.    DosTime:       longint = 0;   {time spent in remote DOS}
  200.    libdisk:       longint = 0;
  201.  
  202.    event_time:    anystring = '';{time last event started or '' if none}
  203.    event_mins:    longint = 0;   {minutes spent processing events}
  204.  
  205.    spare1:        longint = 0;
  206.    spare2:        longint = 0;
  207.    spare3:        longint = 0;
  208.    spare4:        longint = 0;
  209.    spare6:        longint = 0;
  210.    spare7:        longint = 0;
  211.    spare8:        longint = 0;
  212.    spare9:        longint = 0;
  213.    spare10:       longint = 0;
  214.    spare11:       longint = 0;
  215.    spare12:       longint = 0;
  216.    spare13:       longint = 0;
  217.    spare14:       longint = 0;
  218.    spare15:       longint = 0;
  219.    spare16:       longint = 0;
  220.  
  221.  
  222.    Inrec:         FileStr = '';  {64 char line}
  223.    Urec:          anystring = '';{upper case version of inrec}
  224.  
  225.    PeriodCovered: anystring = '';{concats to send to ofd}
  226.  
  227.    min_download:  longint = 2;   {min downloads to include in report}
  228.  
  229.    saveFile:      anystring = 'CALLS.SAV';    {saved history filename}
  230.  
  231.    inName:        anystring = 'CALLER';   {input filename}
  232.  
  233.    outfile:       anystring = 'BLT99';    {output filename}
  234.  
  235.    subtitle:      anystring = '';
  236.  
  237.    reports:       anystring = 'ANBCORPDEFGHIJKLQM';
  238.                                           {list of reports to produce}
  239.  
  240.    {table of peak hours, 'Y'=peak, anything else=not}
  241.                                {          1         2   }
  242.                                {012345678901234567890123}
  243.    PeakTable:     string[24] = 'YNNNNNNNNNNNNNNNNYYYYYYY';
  244.  
  245.    maxConf:       word = maxint;
  246.    maxBlt:        word = maxint;
  247.    maxDoor:       word = maxint;
  248.    maxBatch:      word = maxint;
  249.    maxFree:       word = maxint;
  250.  
  251.    event_mode:    string[20] = 'BUSY';
  252.  
  253.  
  254. const
  255.    FileTree:      FilePointer = nil;
  256.    FirstBatch:    ItemPointer = nil;
  257.    FirstBullet:   ItemPointer = nil;
  258.    FirstConf:     ItemPointer = nil;
  259.    FirstDoor:     ItemPointer = nil;
  260.    FirstBaud:     ItemPointer = nil;
  261.    FirstConType:  ItemPointer = nil;
  262.    FirstSecLevel: ItemPointer = nil;
  263.    FirstFreeDL:   ItemPointer = nil;
  264.  
  265.    FirstAvemins:  ItemPointer = nil;
  266.    FirstSpare3:   ItemPointer = nil;
  267.    FirstSpare4:   ItemPointer = nil;
  268.    FirstSpare5:   ItemPointer = nil;
  269.    FirstSpare6:   ItemPointer = nil;
  270.    FirstSpare7:   ItemPointer = nil;
  271.    FirstSpare8:   ItemPointer = nil;
  272.  
  273.    filever:       integer = 0;
  274.  
  275.    last_rec:      anystring = '';   {last entry in log}
  276.    last_entry:    anystring = '';   {last entry in log}
  277.    last_rec_seen: anystring = '';   {last entry in current log}
  278.  
  279.    first_rec:     anystring = '';   {first entry in log}
  280.    first_entry:   anystring = '';   {first entry in log}
  281.  
  282.    TotHours:      real = 0;         {Total hours from first to last log entry}
  283.    end_hours:     real = 0;
  284.    beg_hours:     real = 0;
  285.  
  286.    Hrs:           array[0..23] of longint = {minutes used by hours}
  287.          (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  288.  
  289. var
  290.    ifd:  text;   {caller log}
  291.  
  292.    ofd:  text;   {file that goes to the bulletin}
  293.  
  294.    iobuf: array[1..10240] of char;
  295.  
  296.  
  297. const
  298.    graph_num = 100;
  299.    graph_set:  string[3] = '░▓▒';
  300.  
  301. type
  302.    sort_keys = (percent_sort, name_sort, no_sort);
  303.  
  304. const
  305.    graph_min:    longint = 0;
  306.    graph_max:    longint = 0;
  307.    graph_lim:    real = 0;
  308.    graph_line:   longint = 0;
  309.    graph_count:  integer = 0;
  310. var
  311.    graph_val:    array[1..graph_num] of real;
  312.    graph_title:  array[1..graph_num] of string[20];
  313.  
  314. const
  315.    pcol: string = '';
  316.  
  317.  
  318.  
  319. (* -------------------------------------------------------- *)
  320. procedure setcolor(col: string);
  321. begin
  322.    if pcol <> col then
  323.    begin
  324.       write(ofd,col);
  325.       pcol := col;
  326.    end;
  327. end;
  328.  
  329.  
  330. (* -------------------------------------------------------- *)
  331. function itoa(l: longint): anystring;
  332. var
  333.    s: anystring;
  334. begin
  335.    str(l,s);
  336.    itoa := s;
  337. end;
  338.  
  339. function wtoa(w: word): anystring;
  340. var
  341.    s: anystring;
  342. begin
  343.    str(w,s);
  344.    wtoa := s;
  345. end;
  346.  
  347.  
  348. (* -------------------------------------------------------- *)
  349. procedure section_title(title:  anystring);
  350.    begin
  351.       writeln(ofd);
  352.       writeln(ofd, '':  35-(length(title) div 2),
  353.             red, '-= ', yellow, title, red, ' =-');
  354.       writeln(ofd);
  355.    end;
  356.  
  357.  
  358. (* -------------------------------------------------------- *)
  359. procedure empty_section;
  360.    begin
  361.       writeln(ofd, gray, '':34,'**NONE**');
  362.    end;
  363.  
  364.  
  365. (* -------------------------------------------------------- *)
  366. procedure start_graph(title:  anystring; limit:  real);
  367.    begin
  368.       graph_lim := limit;
  369.       graph_max := 0;
  370.       graph_min := 100;
  371.       graph_line := 0;
  372.       graph_count := 0;
  373.       section_title(title);
  374.    end;
  375.  
  376. (* -------------------------------------------------------- *)
  377. procedure graph(item:  anystring; n:  real);
  378.    var
  379.       pct:  real;
  380.    begin
  381.       if graph_lim = 0 then
  382.          pct := 0
  383.       else
  384.          pct := abs(n/graph_lim)*100.0;
  385.       if (pct <= 0) or (pct > maxint) then
  386.          exit;
  387.  
  388.       if pct > graph_max then
  389.          graph_max := trunc(pct);
  390.       if pct < graph_min then
  391.          graph_min := trunc(pct*0.7);
  392.  
  393.       if graph_count < graph_num then
  394.          inc(graph_count);
  395.  
  396.       graph_val[graph_count] := n;
  397.       graph_title[graph_count] := item;
  398.    end;
  399.  
  400.  
  401. (* -------------------------------------------------------- *)
  402. procedure graph_output(item:  anystring; n:  real);
  403.    var
  404.       pct:  real;
  405.       i:    integer;
  406.       w:    integer;
  407.       lim:  longint;
  408.    begin
  409.       if graph_line < length(graph_set) then
  410.          inc(graph_line)
  411.       else
  412.          graph_line := 1;
  413.  
  414.       if graph_lim = 0 then
  415.          pct := 0
  416.       else
  417.          pct := abs(n/graph_lim*100.0);
  418.  
  419.       if pct > 150 then
  420.          pct := 150;
  421.  
  422.       write(ofd, green, item:20, ': ', white);
  423.  
  424.       if graph_lim < 0 then
  425.          if pct > 99.9 then
  426.             write(ofd, pct:3:0,' % ')
  427.          else
  428.             write(ofd, pct:4:1, '% ')
  429.       else
  430.  
  431.       begin
  432.          if (int(graph_lim) <> graph_lim) and (graph_lim < 9999.0) then
  433.             write(ofd, n:6:1)
  434.          else
  435.             write(ofd, n:5:0);
  436.  
  437.          if pct > 99.9 then
  438.             write(ofd,gray, ' (',pct:3:0,' %) ')
  439.          else
  440.             write(ofd,gray,' (', pct:4:1, '%) ');
  441.       end;
  442.  
  443.       if graph_lim < 0 then lim := 50 else lim := 42;
  444.  
  445.       if (pct < graph_min) then
  446.          w := 0
  447.       else
  448.       if (graph_min = graph_max) then
  449.          w := lim
  450.       else
  451.          w := round((pct-graph_min)/(graph_max-graph_min)*lim);
  452.  
  453.       if w > lim then
  454.          w := lim;
  455.  
  456.       write(ofd, white, '│', cyan);
  457.  
  458.       for i := 1 to w-1 do
  459.          write(ofd, graph_set[graph_line]);
  460.       if w > 0 then
  461.          write(ofd, white, '█');
  462.  
  463.       writeln(ofd);
  464.    end;
  465.  
  466.  
  467.    (* -------------------------------------------------------- *)
  468.    procedure sort_graph(onkey: sort_keys);
  469.    var
  470.       ts:   string[20];
  471.       tv:   real;
  472.       swap: boolean;
  473.       i,j:  integer;
  474.  
  475.       function swap_needed: boolean;
  476.       begin
  477.          if onkey = percent_sort then
  478.             tv := graph_val[i]-graph_val[i+1]
  479.          else
  480.             tv := 0;
  481.          if tv = 0 then
  482.             if graph_title[i] > graph_title[i+1] then
  483.                tv := -1;
  484.          swap_needed := (tv < 0);
  485.       end;
  486.       
  487.       (* -------------------------------------------------------- *)
  488.       procedure swap_entries;
  489.       begin
  490.          swap := true;
  491.          tv := graph_val[i+1];
  492.          graph_val[i+1] := graph_val[i];
  493.          graph_val[i] := tv;
  494.          ts := graph_title[i+1];
  495.          graph_title[i+1] := graph_title[i];
  496.          graph_title[i] := ts;
  497.       end;
  498.  
  499.    begin
  500.  
  501.      j := graph_count;
  502.      repeat
  503.          swap := false;
  504.          dec(j);
  505.          for i := 1 to j do
  506.             if swap_needed then
  507.                swap_entries;
  508.       until swap = false;
  509.    end;
  510.  
  511.  
  512. (* -------------------------------------------------------- *)
  513. procedure end_graph(onkey: sort_keys; maxcnt: word);
  514.    var
  515.       i:  integer;
  516.  
  517.    begin
  518.       if onkey <> no_sort then
  519.          sort_graph(onkey);
  520.  
  521.       if graph_count > maxcnt then
  522.          graph_count := maxcnt;
  523.  
  524.       for i := 1 to graph_count do
  525.          graph_output(graph_title[i], graph_val[i]);
  526.  
  527.       if graph_count = 0 then
  528.          empty_section;
  529.  
  530.       writeln(ofd);
  531.    end;
  532.  
  533.  
  534. (* -------------------------------------------------------- *)
  535.    procedure graph_list(node:    ItemPointer;
  536.                         title:   string;
  537.                         n:       real;
  538.                         key:     sort_keys;
  539.                         maxcnt:  word);
  540.    begin
  541.       if maxcnt = maxint then
  542.          start_graph(title,n)
  543.       else
  544.          start_graph('Top '+itoa(maxcnt)+' '+title,n);
  545.  
  546.       while (node <> nil) do
  547.       begin
  548.          graph(node^.name, node^.count);
  549.          node := node^.next;
  550.       end;
  551.  
  552.       end_graph(key,maxcnt);
  553.    end;
  554.  
  555.  
  556. (* -------------------------------------------------------- *)
  557. procedure walk_tree( var Node:  FilePointer;
  558.                      var a:  integer);
  559.    {traverse the binary filename tree and output in sorted order}
  560. begin
  561.    if Node = nil then exit;
  562.  
  563.    walk_tree(Node^.lower, a);
  564.  
  565.    if Node^.count >= min_download then
  566.    begin
  567.       case Node^.count-min_download of
  568.          0.. 2: write(ofd, cyan,   '     ');
  569.          3.. 6: write(ofd, green,  '   * ');
  570.          7..12: write(ofd, red,    '  ** ');
  571.         13..24: write(ofd, yellow, ' *** ');
  572.          else   write(ofd, white,  '**** ');
  573.       end;
  574.  
  575.       write(ofd, Node^.name:  12, Node^.count:  5);
  576.  
  577.       if a mod 3 = 0 then
  578.          writeln(ofd)
  579.       else
  580.          write(ofd,'   ');
  581.  
  582.       inc(a);
  583.    end;
  584.  
  585.    walk_tree(Node^.higher, a);
  586. end;
  587.  
  588.  
  589. (* -------------------------------------------------------- *)
  590. procedure output_results(outfile: anystring);
  591.    var
  592.       UsedHours:  real;
  593.       DownEffic:  real;
  594.       UpEffic:    real;
  595.       daymsg:     anystring;
  596.       Days:       longint;
  597.       report:     integer;
  598.       c:          char;
  599.       PeakUsed:   real;
  600.       PeakHours:  real;
  601.  
  602.       procedure init_report;
  603.       var
  604.          i,j,k: integer;
  605.          pr:    array[0..23] of real;
  606.          ph:    array[0..23] of integer;
  607.          th:    integer;
  608.          tr:    real;
  609.       begin
  610.          gotoxy(15, 15);
  611.          highvideo;
  612.          textcolor(ansicrt.yellow);
  613.  
  614.          gotoxy(1, 2);
  615.          write('Sending output to ', outfile,' ');
  616.  
  617.          assign(ofd, outfile);
  618.          rewrite(ofd);
  619.          setTextbuf(ofd,iobuf);
  620.  
  621.          UsedHours := int(UsedMinutes)/60.0+int(Hours);
  622.  
  623.          if TotHours < 1 then
  624.             TotHours := 1;
  625.          Days := trunc( (TotHours+23.9) /24.0 );
  626.          daymsg := itoa((days{+nodes-1}) div nodes);
  627.  
  628.          {automatically choose peak hours if needed}
  629.          if PeakTable = 'AUTO' then
  630.          begin
  631.             for i := 0 to 23 do
  632.             begin
  633.                ph[i] := i+1;
  634.                pr[i] := hrs[i];
  635.             end;
  636.             for i := 22 downto 1 do
  637.                for j := 0 to i do
  638.                   if pr[j] < pr[j+1] then
  639.                   begin
  640.                      tr := pr[j];
  641.                      th := ph[j];
  642.                      pr[j] := pr[j+1];
  643.                      ph[j] := ph[j+1];
  644.                      pr[j+1] := tr;
  645.                      ph[j+1] := th;
  646.                   end;
  647.             PeakTable := 'NNNNNNNNNNNNNNNNNNNNNNNN';
  648.             for i := 0 to 5 do
  649.                PeakTable[ph[i]] := 'Y';
  650.          end;
  651.  
  652.          {calculate number of hours in peak times}
  653.          i := 0;
  654.          for j := 0 to 23 do
  655.             if PeakTable[j+1] = 'Y' then
  656.                inc(i);
  657.          if i = 0 then
  658.             i := 24;
  659.          PeakHours := TotHours / 24.0 * int(i);
  660.  
  661.          {calculate time used in peak times}
  662.          if i = 24 then
  663.             PeakUsed := UsedHours
  664.          else
  665.          begin
  666.             PeakUsed := 0;
  667.             for j := 0 to 23 do
  668.                if PeakTable[j+1] = 'Y' then
  669.                   PeakUsed := PeakUsed + int(hrs[j])/60.0;
  670.          end;
  671.  
  672.          writeln(ofd,white);
  673.          writeln(ofd, '               Calls ', version, ' - Call Analyzer ',pcbversion);
  674.          writeln(ofd, blue, '            ', PeriodCovered);
  675.       end;
  676.  
  677.       procedure system_statistics;
  678.       begin
  679.          if nodes > 1 then
  680.             section_title('Combined Statistics for '+itoa(nodes)+' nodes over '+daymsg+' days')
  681.          else
  682.             section_title('System Statistics for '+daymsg+' days');
  683.  
  684.          if SubTitle <> '' then
  685.             section_title(subTitle);
  686.  
  687.          if (caller = 0) or (days = 0) or
  688.             (totHours = 0) or (peakHours = 0) then exit;
  689.  
  690.          write  (ofd, green, '  Directory Scans........ ', white, dirscan:6);
  691.          writeln(ofd, green, '  Messages Left.......... ':33, white, mssgs:6);
  692.  
  693.          write  (ofd, green, '  Doors Opened........... ', white, DOORs:6);
  694.          writeln(ofd, green, '    Comments Left........ ':33, white, comments:6);
  695.  
  696.          write  (ofd, green, '  Downloads Completed.... ', white, down:6);
  697.          writeln(ofd, green, '    Qmail Messages Left.. ':33, white, Qmssgs:6);
  698.  
  699.          write  (ofd, green, '    Different Files...... ', white, UniqFiles:6);
  700.          writeln(ofd, green, '    MarkMail Messages.... ':33, white, Mmssgs:6);
  701.  
  702.          write  (ofd, green, '    Downloads Aborted.... ', white, d_abort:6);
  703.          writeln(ofd, green, '    ZIPM Executed........ ':33, white, zipmail:6);
  704.  
  705.          write  (ofd, green, '    Free Downloads....... ', white, free_down:6);
  706.          writeln(ofd, green, '    ZIPM Messages........ ':33, white, msgcount:6);
  707.  
  708.          write  (ofd, green, '  LIB Executed........... ', white, libdisk:6);
  709.          writeln(ofd, green, '  Number of Callers...... ':33, white, caller:6);
  710.  
  711.          write  (ofd, green, '  REPACK Executed........ ', white, repacks:6);
  712.          writeln(ofd, green, '    New Users Registered. ':33, white, new_guys:6);
  713.  
  714.          write  (ofd, green, '  TEST Executed.......... ', white, testexec:6);
  715.          writeln(ofd, green, '    Ave. Calls Per Day... ':33, white, nodes*caller/Days:6:1);
  716.  
  717.          write  (ofd, green, '  Uploads Completed...... ', white, up:6);
  718.          writeln(ofd, green, '    Ave. Call Duration... ':33, white, (UsedHours*60)/caller:6:1);
  719.  
  720.          write  (ofd, green, '    Bad Uploads Deleted.. ', white, invalids:6);
  721.          writeln(ofd, green, '    Ave. Idle Time....... ':33, white, (TotHours-UsedHours)*60/caller:6:1);
  722.  
  723.          write  (ofd, green, '    Uploads Aborted...... ', white, u_abort:6);
  724.          writeln(ofd, green, '  Scripts Completed...... ':33, white, question:6);
  725.  
  726.          write  (ofd, green, '  VIEW Executed.......... ', white, viewexec:6);
  727.          writeln(ofd, green, '  Total Operation Hours.. ':33, white, TotHours:6:1);
  728.  
  729.          write  (ofd, green, '    Members Extracted.... ', white, extmember:6);
  730.          writeln(ofd, green, '    Utilization Hours.... ':33, white, UsedHours:6:1);
  731.  
  732.          write  (ofd, green, '    Members Viewed....... ', white, viewmember:6);
  733.          writeln(ofd, green, '    Total Utilization %.. ':33, white, (UsedHours/TotHours)*100:6:1);
  734.  
  735.          write  (ofd, '':32);
  736.          writeln(ofd, green, '    Peak Utilization %... ':33, white, (PeakUsed/PeakHours)*100:6:1);
  737.          writeln(ofd);
  738.       end;
  739.  
  740.       procedure security_statistics;
  741.       var
  742.          evmins:  real;
  743.       begin
  744.          section_title('Security Statistics');
  745.  
  746.          write  (ofd, green, '  Automatic Lockouts..... ', white, lockouts:6);
  747.          writeln(ofd, green, '  Node Chats Initiated... ':33, white, nchat:6);
  748.  
  749.          write  (ofd, green, '  Password Failures...... ', white, pwfail:6);
  750.          writeln(ofd, green, '  Sysop Chats Initiated.. ':33, white, schat:6);
  751.  
  752.          write  (ofd, green, '  Refused to Register.... ', white, refused:6);
  753.          writeln(ofd, green, '  Sysop Paged............ ':33, white, sysop_paged:6);
  754.  
  755.          write  (ofd, green, '  Remote DOS Time (min).. ', white, DosTime:6);
  756.          writeln(ofd, green, '  Sysop Sessions......... ':33, white, sysop_local+sysop_remote:6);
  757.  
  758.          write  (ofd, green, '  Remote Drops to DOS.... ', white, DosTimes:6);
  759.          writeln(ofd, green, '  Time Limit Expired..... ':33, white, time_limit:6);
  760.  
  761.          write  (ofd, green, '  Scheduled Events....... ', white, events:6);
  762.          writeln(ofd, green, '  Trashcan Names......... ':33, white, tcan:6);
  763.  
  764.          if event_mode = 'OFF' then
  765.             write(ofd, '':32)
  766.          else
  767.          begin
  768.             if events = 0 then
  769.                evmins := 0
  770.             else
  771.                evmins := event_mins/(events*nodes);
  772.             write  (ofd, green, '  Ave Event Length (min). ', white, evmins:6:1);
  773.          end;
  774.  
  775.          writeln(ofd, green, '  Security Violations.... ':33, white, secviol:6);
  776.          writeln(ofd);
  777.       end;
  778.  
  779.       procedure graphic_modes;
  780.       var
  781.          k: longint;
  782.       begin
  783.          k := (graphics+non_graphics+even_parity);
  784.          start_graph('Graphics Modes', k);
  785.          graph('Color Graphics', graphics);
  786.          graph('Non Graphics', non_graphics);
  787.          graph('7 Bit Even-Parity', even_parity);
  788.          end_graph(percent_sort,maxint);
  789.       end;
  790.  
  791.       procedure baud_rates;
  792.       begin
  793.          graph_list(FirstBaud,'Baud Rates', caller, percent_sort, maxint);
  794.       end;
  795.  
  796.       procedure connect_types;
  797.       begin
  798.          graph_list(FirstConType,'Connect Types', caller, percent_sort, maxint);
  799.       end;
  800.  
  801.       procedure security_levels;
  802.       begin
  803.          graph_list(FirstSecLevel,'Number of Calls by Security Level', caller, percent_sort, maxint);
  804.       end;
  805.  
  806.       procedure average_minutes;
  807.       begin
  808.          graph_list(FirstAveMins,'Hours Used by Security Level', UsedMinutes/60.0+UsedHours, percent_sort, maxint);
  809.       end;
  810.  
  811.       procedure free_downloads;
  812.       begin
  813.          graph_list(FirstFreeDL,'Free Downloads', caller, percent_sort, maxFree);
  814.       end;
  815.  
  816.       procedure hourly_usage;
  817.       var
  818.          hits: longint;
  819.          slot: integer;
  820.          a:    integer;
  821.          k:    integer;
  822.          whole_days:  real;
  823.  
  824.       begin
  825.          section_title('Average Percent of Hourly Usage');
  826.  
  827.          write(ofd, green, '       00');
  828.          for a := 1 to 23 do
  829.          begin
  830.             if a < 10 then write(ofd,'  ') else write(ofd,' ');
  831.             write(ofd,a);
  832.          end;
  833.          writeln(ofd);
  834.  
  835.          whole_days := int((TotHours+23)/24) * 0.60;
  836.  
  837.          hits := 0;
  838.          for k := 20 downto 1 do 
  839.          begin
  840.             write(ofd, green, k*5:  3, '%');
  841.             pcol := '';
  842.             setcolor(white);
  843.             write(ofd, ' │ ');
  844.             hits := 0;
  845.  
  846.             for a := 0 to 23 do 
  847.             begin
  848.                c := graph_set[(a mod 3)+1];
  849.                slot := round( (hrs[a] / whole_days) / 5);
  850.                if slot > 20 then
  851.                   slot := 20;
  852.  
  853.                if slot = k then
  854.                begin
  855.                   setcolor(white);
  856.                   write(ofd, '██ ');
  857.                end
  858.                else
  859.  
  860.                if slot > k then
  861.                begin
  862.                   setcolor(cyan);
  863.                   write(ofd, c,c,' ');
  864.                   inc(hits);
  865.                end
  866.                else 
  867.  
  868.                begin
  869.                   setcolor(blue);
  870.                   write(ofd, ' · ');
  871.                end;
  872.             end;
  873.  
  874.             writeln(ofd);
  875.          end;
  876.  
  877.          write(ofd, green, '       00');
  878.          for a := 1 to 23 do
  879.          begin
  880.             if a < 10 then write(ofd,'  ') else write(ofd,' ');
  881.             write(ofd,a);
  882.          end;
  883.          writeln(ofd);
  884.  
  885.          write(ofd, yellow, 'Peak: ', red);
  886.          for a := 0 to 23 do
  887.             if PeakTable[a+1] = 'Y' then
  888.                write(ofd,' **')
  889.             else
  890.                write(ofd,'   ');
  891.          writeln(ofd);
  892.          writeln(ofd);
  893.       end;
  894.  
  895.       procedure conferences_joined;
  896.       begin
  897.          graph_list(FirstConf,'Conferences Joined', joins, percent_sort, maxConf);
  898.       end;
  899.  
  900.       procedure bulletins_read;
  901.       begin
  902.          graph_list(FirstBullet,'Bulletins Read', blts, percent_sort, maxBlt);
  903.       end;
  904.  
  905.       procedure doors_opened;
  906.       begin
  907.          graph_list(FirstDoor,'Doors Opened', DOORs, percent_sort, maxDoor);
  908.       end;
  909.  
  910.       procedure download_protocols;
  911.       var
  912.          k: integer;
  913.       begin
  914.          start_graph('Protocol Usage (Downloading)', down);
  915.          for k := 1 to ProtocolCount do
  916.             with Protocol[k] do
  917.                if (Downloads <> 0) then
  918.                   graph(Name, Downloads);
  919.          end_graph(percent_sort,maxint);
  920.       end;
  921.  
  922.       procedure download_efficiency;
  923.       var
  924.          k: integer;
  925.       begin
  926.          start_graph('Average Protocol Efficiency (Downloading)', -100);
  927.          for k := 1 to ProtocolCount do
  928.             with Protocol[k] do
  929.                if (Downloads <> 0) and (DownTime <> 0) then
  930.                   begin
  931.                      DownEffic := 100.0*DownIdeal/DownTime;
  932.                      graph(Name, DownEffic);
  933.                   end;
  934.          end_graph(percent_sort,maxint);
  935.       end;
  936.  
  937.       procedure upload_protocols;
  938.       var
  939.          k: integer;
  940.       begin
  941.          start_graph('Protocol Usage (Uploading)', up);
  942.          for k := 1 to ProtocolCount do
  943.             with Protocol[k] do
  944.                if (Uploads <> 0) then
  945.                   graph(Name, Uploads);
  946.          end_graph(percent_sort,maxint);
  947.       end;
  948.  
  949.       procedure upload_efficiency;
  950.       var
  951.          k: integer;
  952.       begin
  953.          start_graph('Average Protocol Efficiency (Uploading)', -100);
  954.          for k := 1 to ProtocolCount do
  955.             with Protocol[k] do
  956.                if (Uploads <> 0) and (UpTime <> 0) then
  957.                   begin
  958.                      UpEffic := 100.0*UpIdeal/UpTime;
  959.                      graph(Name, UpEffic);
  960.                   end;
  961.          end_graph(percent_sort,maxint);
  962.       end;
  963.  
  964.       procedure batch_sizes;
  965.       begin                                                    {name_sort}
  966.          graph_list(FirstBatch,'Batch Transfer Sizes', batchs, percent_sort, maxBatch);
  967.       end;
  968.  
  969.       procedure files_downloaded;
  970.       var
  971.          a: integer;
  972.          s: anystring;
  973.       begin
  974.          if min_download = 1 then
  975.             s := ''
  976.          else
  977.             s := ' '+ itoa(min_download) + ' or More Times';
  978.  
  979.          section_title('Files Downloaded'+s);
  980.          if down < 1 then
  981.             empty_section
  982.          else
  983.             begin
  984.                a := 1;
  985.                walk_tree(FileTree, a);
  986.             end;
  987.          writeln(ofd);
  988.       end;
  989.  
  990. (* -------------------------------------------------------- *)
  991.    begin
  992.       init_report;
  993.  
  994.       for report := 1 to length(reports) do
  995.          case upcase(reports[report]) of
  996.            'A': system_statistics;
  997.            'B': graphic_modes;
  998.            'C': baud_rates;
  999.            'D': hourly_usage;
  1000.            'E': conferences_joined;
  1001.            'F': bulletins_read;
  1002.            'G': doors_opened;
  1003.            'H': download_protocols;
  1004.            'I': download_efficiency;
  1005.            'J': upload_protocols;
  1006.            'K': upload_efficiency;
  1007.            'L': batch_sizes;
  1008.            'M': files_downloaded;
  1009.            'N': security_statistics;
  1010.            'O': security_levels;
  1011.            'P': connect_types;
  1012.            'Q': free_downloads;
  1013.            'R': average_minutes;
  1014.            'Z': writeln(ofd);
  1015.          end;
  1016.  
  1017.       write(ofd,gray);
  1018.       close(ofd);
  1019.    end;
  1020.  
  1021.  
  1022.  
  1023. (* -------------------------------------------------------- *)
  1024. procedure getrec;
  1025.    var
  1026.       c:    char;
  1027.    begin
  1028.       Qreadln(ifd, Inrec, sizeof(Inrec));
  1029.       Urec := Inrec;
  1030.       stoupper(Urec);
  1031.  
  1032.       if Urec[3] = '-' then
  1033.          last_rec_seen := Urec;
  1034.  
  1035.       if keypressed then
  1036.       begin
  1037.          c := readkey;
  1038.          if c = #27 then
  1039.          begin
  1040.             gotoxy(1, 24);
  1041.             writeln('** ESC pressed - Aborted **');
  1042.             delay(2000);
  1043.             halt;
  1044.          end;
  1045.       end;
  1046.    end;
  1047.  
  1048.  
  1049.  
  1050. (* -------------------------------------------------------- *)
  1051. procedure add_item(var FirstItem:  ItemPointer;
  1052.                    ItemName:       ItemNameStr;
  1053.                    Number:         real);
  1054. var
  1055.    NewItem:  ItemPointer;
  1056.  
  1057. begin
  1058.    NewItem := FirstItem;
  1059.    while NewItem <> nil do
  1060.       if NewItem^.name = ItemName then
  1061.          begin
  1062.             NewItem^.count := NewItem^.count + Number;
  1063.             exit;
  1064.          end
  1065.       else
  1066.          NewItem := NewItem^.next;
  1067.  
  1068.    new(NewItem);          { get a new record}
  1069.    NewItem^.next := FirstItem;
  1070.    FirstItem := NewItem;
  1071.    NewItem^.name := ItemName;
  1072.    NewItem^.count := Number;
  1073. end;
  1074.  
  1075.  
  1076. (* -------------------------------------------------------- *)
  1077. procedure store_name(var Node:  FilePointer;
  1078.                      var Name:  anystring;
  1079.                      var Size:  longint);
  1080.       {stores the name in the sorted name tree; recursive}
  1081.  
  1082.    begin
  1083.  
  1084.       if Urec[8] = 'U' then
  1085.       begin
  1086.          size := 100000;
  1087.          exit;
  1088.       end;
  1089.  
  1090.  
  1091.       (* insert new nodes *)
  1092.       if Node = nil then
  1093.       begin
  1094.          new(Node);
  1095.          Node^.count := 1;
  1096.          Node^.name := Name;
  1097.          Node^.size := 100000;
  1098.          Size := Node^.size;
  1099.          Node^.higher := nil;
  1100.          Node^.lower := nil;
  1101.          inc(UniqFiles);
  1102.       end
  1103.       else
  1104.  
  1105.       (* count existting nodes *)
  1106.       if Node^.name = Name then
  1107.       begin
  1108.          inc(Node^.count);
  1109.          Size := Node^.size;
  1110.       end
  1111.       else
  1112.  
  1113.       (* else traverse the tree looking for the right node *)
  1114.       if Name > Node^.name then
  1115.          store_name(Node^.higher,Name,Size)
  1116.       else
  1117.          store_name(Node^.lower,Name,Size);
  1118.    end;
  1119.  
  1120.  
  1121. (* -------------------------------------------------------- *)
  1122. function pos(pattern: string; value: string): integer;
  1123. var
  1124.    i: integer;
  1125. begin
  1126.    if length(pattern) = 1 then
  1127.    begin
  1128.       for i := 1 to length(value) do
  1129.          if value[i] = pattern[1] then
  1130.          begin
  1131.             pos := i;
  1132.             exit;
  1133.          end;
  1134.       pos := 0;
  1135.    end
  1136.    else
  1137.       pos := system.pos(pattern,value);
  1138. end;
  1139.  
  1140.  
  1141. (* -------------------------------------------------------- *)
  1142. type
  1143.    str12 = string[12];
  1144.    str80 = string[80];
  1145.  
  1146. {  This Function returns a name expanded to line up both the name and ext    }
  1147. {  for example:  abc.com      =  abc      com                                }
  1148. {                datafile.1   =  datafile   1                                }
  1149.  
  1150. function ExpandName(name:  str12):  str12;
  1151.  
  1152.    var
  1153.       Counter, DotPos:  integer;
  1154.  
  1155.    begin
  1156.       DotPos := pos('.', name); {where's the dot at?}
  1157.       if DotPos = 0 then
  1158.       begin
  1159.          repeat
  1160.             name := name+' '; {If no ext, pad with spaces}
  1161.          until length(name) = 12;
  1162.       end else
  1163.       begin
  1164.          delete(name, DotPos, 1);
  1165.          repeat
  1166.             insert(' ', name, DotPos);
  1167.          until length(name) = 12;
  1168.       end;
  1169.       ExpandName := name;
  1170.    end;
  1171.  
  1172.  
  1173. (* -------------------------------------------------------- *)
  1174. procedure print(col, row:  integer;
  1175.                 str:       str80;
  1176.                 Attrib:    integer);
  1177.    begin
  1178.       gotoxy(col, row);
  1179.       textcolor(Attrib);
  1180.       write(str);
  1181.    end;
  1182.  
  1183.  
  1184. (* -------------------------------------------------------- *)
  1185. function Time:  real;
  1186.    var
  1187.       Reg:  Registers;
  1188.  
  1189.    begin Reg.AX := $2C00;
  1190.       intr($21, Reg);
  1191.       Time := (Reg.CX shr 8)*3600 {Hours}
  1192.              +(Reg.CX and $00FF)*60 {Minutes}
  1193.              +(Reg.DX shr 8)      { * 1 }
  1194.                                   {Seconds    }
  1195.              +(Reg.DX and $00FF)/100; {Hundredths }
  1196.    end;
  1197.  
  1198.  
  1199.  
  1200. (* -------------------------------------------------------- *)
  1201. procedure calculate_event_time;
  1202.    var
  1203.       minbeg,hourbeg:   integer;
  1204.       minend,hourend:   integer;
  1205.       a:                integer;
  1206.       timebeg:          integer;
  1207.       timeend:          integer;
  1208.       mins:             integer;
  1209.  
  1210.    begin
  1211.       val(copy(event_time,1,2),hourbeg,a);
  1212.       if hourbeg > 23 then
  1213.          hourbeg := hourbeg - 24;
  1214.       val(copy(event_time,4,2),minbeg,a);
  1215.       event_time := '';
  1216.  
  1217.       val(copy(Urec,11,2),hourend,a);
  1218.       if hourend > 23 then
  1219.          hourend := hourend - 24;
  1220.       val(copy(Urec,14,2),minend,a);
  1221.  
  1222.       timebeg := hourbeg*60 + minbeg;
  1223.       timeend := hourend*60 + minend;
  1224.       if timeend < timebeg then
  1225.          timeend := timeend + 1440;
  1226.  
  1227.       mins := timeend-timebeg;
  1228.       event_mins := event_mins + mins;
  1229.  
  1230.       if event_mode = 'BUSY' then
  1231.       begin
  1232.          while mins > 0 do
  1233.          begin
  1234.             if mins > minend then
  1235.                a := minend
  1236.             else
  1237.                a := mins;
  1238.  
  1239.             UsedMinutes := UsedMinutes + a;
  1240.             while UsedMinutes > 60 do
  1241.             begin
  1242.                inc(Hours);
  1243.                UsedMinutes := UsedMinutes - 60;
  1244.             end;
  1245.  
  1246.             Hrs[hourend] := Hrs[hourend]+a;
  1247.             mins := mins-a;
  1248.  
  1249.             if hourend > 0 then
  1250.                dec(hourend)
  1251.             else
  1252.                hourend := 23;
  1253.             minend := 60;
  1254.          end;
  1255.       end;
  1256.    end;
  1257.  
  1258.  
  1259.  
  1260. (* -------------------------------------------------------- *)
  1261. procedure incaller;
  1262.    var
  1263.       posit:   integer;
  1264.       num:     integer;
  1265.       j:       integer;
  1266.       temp:    anystring;
  1267.       BaudName:anystring;
  1268.  
  1269.    begin
  1270.       temp := copy(Urec,23,99);
  1271.       posit := pos(') (',temp);
  1272.       if posit = 0 then
  1273.          exit;
  1274.  
  1275.       inc(caller);
  1276.  
  1277.       if pos(' (LOCAL) (', Urec) <> 0 then
  1278.       begin
  1279.          inc(sysop_local);
  1280.          BaudName := 'Local ';
  1281.          add_item(FirstBaud, BaudName, 1);
  1282.          baud := 0;
  1283.       end
  1284.       else
  1285.  
  1286.       begin
  1287.          if pos(' SYSOP (', Urec) > 0 then
  1288.             inc(sysop_remote);
  1289.  
  1290.          j := posit-1;
  1291.          while (j > 0) and (temp[j] <> '(') do
  1292.             dec(j);
  1293.          inc(j);
  1294.          BaudName := copy(temp,j,posit-j);
  1295.  
  1296.          j := length(BaudName);
  1297.          if BaudName[j] <> 'E' then
  1298.             BaudName := BaudName + ' ';
  1299.  
  1300.          add_item(FirstBaud, BaudName, 1);
  1301.  
  1302.          dec(BaudName[0]);
  1303.          {writeln('baud=[',baudName,']');}
  1304.          baud := 0;
  1305.          val(BaudName,baud,posit);
  1306.       end;
  1307.  
  1308.       if pos('(G', Urec) > 0 then inc(graphics)
  1309.       else if pos('(N', Urec) > 0 then inc(non_graphics)
  1310.       else if pos('(7', Urec) > 0 then inc(even_parity);
  1311.  
  1312.       if pos(' TRASHCAN ', Urec) > 0 then inc(tcan);
  1313.  
  1314.       if event_time <> '' then
  1315.          calculate_event_time;
  1316.  
  1317.       clevel := '';
  1318.    end;
  1319.  
  1320.  
  1321. (* -------------------------------------------------------- *)
  1322. procedure indownload;      {upload/downloaded file stuff}
  1323.    var
  1324.       prot:    char;
  1325.       posit:   integer;
  1326.       k:       integer;
  1327.       CPS:     real;
  1328.       FileName:  string[12];
  1329.       tmp:     string;
  1330.       size:    longint;
  1331.       ideal:   real;
  1332.       Time:    real;
  1333.  
  1334.    begin
  1335.       if Urec[9] <> ')' then exit;
  1336.  
  1337.       if pos(' ABORTED ', Urec) > 0 then
  1338.       begin
  1339.          if Urec[8] = 'D' then
  1340.             inc(d_abort) {Aborted dl's}
  1341.          else
  1342.             inc(u_abort);
  1343.          exit;
  1344.       end;
  1345.  
  1346.       posit := pos(' COMPLETED ', Urec); {find End of name}
  1347.       if posit=0 then exit;
  1348.  
  1349.       {determine file name}
  1350.       FileName := ExpandName(copy(Urec, 11, (posit-11)));
  1351.       if FileName[1] = ' ' then exit;
  1352.  
  1353.       {store name, return file size}
  1354.       store_name(FileTree,FileName,size);
  1355.  
  1356.       {determine transfer time}
  1357.       if baud <> 0 then
  1358.          ideal := size/baud*10.0
  1359.       else
  1360.          ideal := 111;
  1361.  
  1362.       {determine actual transfer time}
  1363.       posit := pos('CPS=', Urec);
  1364.       if posit = 0 then
  1365.          CPS := baud/11.0
  1366.       else
  1367.       begin
  1368.          tmp := copy(Urec,posit+4,6);
  1369.          posit := pos(' ',tmp);
  1370.          tmp := copy(tmp,1,posit-1);
  1371.          CPS := 0;
  1372.          val(tmp,cps,posit);
  1373.       end;
  1374.  
  1375.       if (CPS < 20) or (CPS > (baud/5.0)) then
  1376.       begin
  1377.          Time := 0;     {don't consider aborted or invalid transfers}
  1378.          ideal := 0;
  1379. (***
  1380.          gotoxy(1,3);
  1381.          writeln('Download time out of range: CPS=',CPS:4:0,' Min=20 Max=',baud/5:0:0);
  1382.          writeln(urec);
  1383. ***)
  1384.       end
  1385.       else
  1386.          Time := size/CPS;
  1387.  
  1388.       {determine protocol and find table entry}
  1389.       posit := pos(' USING ', Urec);
  1390.       prot := Urec[posit+7];
  1391.  
  1392.       for k := 1 to ProtocolCount do
  1393.       with Protocol[k] do
  1394.  
  1395.          if (Code = prot) or (Code = '?') then
  1396.          begin
  1397.             if Code = '?' then
  1398.             begin
  1399.                gotoxy(1,3);
  1400.                writeln('Unknown protocol: ',Urec);
  1401.             end;
  1402.  
  1403.             if Urec[8] = 'D' then
  1404.             begin
  1405.                inc(Downloads);
  1406.                DownTime := DownTime+Time;
  1407.                DownIdeal := DownIdeal+ideal;
  1408.                inc(down);
  1409.             end
  1410.             else
  1411.             begin
  1412.                inc(Uploads);
  1413.                UpTime := UpTime+Time;
  1414.                UpIdeal := UpIdeal+ideal;
  1415.                inc(up);
  1416.             end;
  1417.  
  1418.             exit;
  1419.          end;
  1420.    end;
  1421.  
  1422.  
  1423. (* -------------------------------------------------------- *)
  1424. procedure confjoin;        {conferences joined}
  1425.    var
  1426.       posit:   integer;
  1427.       ConfName:  anystring;
  1428.  
  1429.    begin
  1430.       posit := pos(' CONFERENCE', Urec);
  1431.       if posit < 8 then
  1432.          exit;
  1433.  
  1434.       ConfName := copy(Inrec, 7, 10);
  1435.       posit := pos(' ',ConfName);
  1436.       if posit > 0 then
  1437.          ConfName[0] := chr(posit-1);
  1438.  
  1439.       case ConfName[1] of
  1440.          '0'..'9', 'a'..'z', 'A'..'Z':
  1441.          begin
  1442.             inc(joins);
  1443.             add_item(FirstConf, ConfName, 1);
  1444.          end;
  1445.       end;
  1446.    end;
  1447.  
  1448.  
  1449. (* -------------------------------------------------------- *)
  1450. procedure batch;        {batch transfer}
  1451.    var
  1452.       posit:   integer;
  1453.       num:     integer;
  1454.       BatchName:  anystring;
  1455.       temp:    anystring;
  1456.  
  1457.    begin
  1458.       posit := pos(' FILES', Urec);
  1459.       temp := copy(Urec,7,posit-7);
  1460.       num := 0;
  1461.       val(temp,num,posit);
  1462.       if num < 1 then
  1463.          exit;
  1464.       if Urec[posit+7] = '0' then
  1465.          exit;
  1466.  
  1467.       if num = 1 then
  1468.          BatchName := '  Single Files'
  1469.       else
  1470.          BatchName := itoa(num) + ' Files';
  1471.  
  1472.       batchs := batchs + num;
  1473.       add_item(FirstBatch, BatchName, num);
  1474.    end;
  1475.  
  1476.  
  1477. (* -------------------------------------------------------- *)
  1478. procedure zipmsgs;        {ziphived message count}
  1479.    var
  1480.       posit:   integer;
  1481.       num:     integer;
  1482.    
  1483.    begin
  1484.       posit := pos(' MESSA', Urec);
  1485.       num := 0;
  1486.       val(copy(Urec,7,posit-7),num,posit);
  1487.       if num < 1 then
  1488.          exit;
  1489.       msgcount := msgcount + num;
  1490.    end;
  1491.  
  1492.  
  1493. (* -------------------------------------------------------- *)
  1494. var
  1495.    numdays:  integer;
  1496.  
  1497. function finday(Days:  integer):  integer;
  1498.    begin
  1499.       case Days of
  1500.         12:  numdays := 334;
  1501.         11:  numdays := 304;
  1502.         10:  numdays := 273;
  1503.          9:  numdays := 243;
  1504.          8:  numdays := 212;
  1505.          7:  numdays := 181;
  1506.          6:  numdays := 151;
  1507.          5:  numdays := 120;
  1508.          4:  numdays := 90;
  1509.          3:  numdays := 59;
  1510.          2:  numdays := 31;
  1511.          1:  numdays := 0;
  1512.       end;                 {case}
  1513.       finday := numdays;
  1514.    end;
  1515.  
  1516.  
  1517. (* -------------------------------------------------------- *)
  1518. procedure bulletins;
  1519.    var
  1520.       posit:      integer;
  1521.       BltNumber:  anystring;
  1522.       BltName:    anystring;
  1523.  
  1524.    begin
  1525.       BltName := copy(Inrec, 22, 10);
  1526.       posit := pos(' ', BltName);
  1527.       if posit > 0 then
  1528.          BltName[0] := chr(posit-1);
  1529.       if length(BltName) = 0 then
  1530.          exit;
  1531.  
  1532.       posit := pos('#', Inrec);
  1533.       if posit = 0 then
  1534.          exit;
  1535.       BltNumber := copy(Inrec,posit+2,4);
  1536.       posit := pos(' ', BltNumber);
  1537.       if posit > 0 then
  1538.          BltNumber[0] := chr(posit-1);
  1539.       while length(BltNumber) < 3 do
  1540.          BltNumber := ' ' + BltNumber;
  1541.  
  1542.       BltName := BltName + ' #' + BltNumber;
  1543.       inc(blts);
  1544.       add_item(FirstBullet, BltName, 1);
  1545.    end;                    {bulletins}
  1546.  
  1547.  
  1548. (* -------------------------------------------------------- *)
  1549. procedure sec_level;
  1550.    var
  1551.       Name: anystring;
  1552.       p: integer;
  1553.    begin
  1554.       p := pos(':',Inrec);
  1555.       if p = 0 then exit;
  1556.       Name := copy(Inrec,p+1,19);
  1557.       while Name[length(Name)] = ' ' do
  1558.          dec(Name[0]);
  1559.       while copy(Name,1,1) = ' ' do
  1560.          delete(Name,1,1);
  1561.       if Name = '' then exit;
  1562.  
  1563.       while length(Name) < 3 do
  1564.          Name := ' ' + Name;
  1565.       Name := 'Level '+Name;
  1566.       add_item(FirstSecLevel, Name, 1);
  1567.       clevel := Name;
  1568.    end;
  1569.  
  1570.  
  1571. (* -------------------------------------------------------- *)
  1572. procedure con_type;
  1573.    var
  1574.       Name: anystring;
  1575.  
  1576.    begin          {......Connect Type: xxxx}
  1577.       Name := copy(Inrec,21,255);
  1578.       while Name[length(name)] = ' ' do
  1579.          dec(Name[0]);
  1580.       if (copy(Name,1,8) = 'CARRIER ') or (copy(Name,1,8) = 'CONNECT ') then
  1581.          Name := copy(Name,9,255);
  1582.       add_item(FirstConType, Name, 1);
  1583.    end;
  1584.  
  1585.  
  1586. (* -------------------------------------------------------- *)
  1587. procedure pfree_down;
  1588.    var
  1589.       Name: anystring;
  1590.  
  1591.    begin          {......Free Download: xxxx}
  1592.       Name := copy(Inrec,22,12);
  1593.       add_item(FirstFreeDL, Name, 1);
  1594.       inc(free_down)
  1595.    end;
  1596.  
  1597.  
  1598. (* -------------------------------------------------------- *)
  1599. procedure pdoors;
  1600.    var
  1601.       posit:      integer;
  1602.       DoorName:   string[40];
  1603.  
  1604.    begin
  1605.       if pos(' AT ', Urec) = 0 then exit;
  1606.  
  1607.       posit := pos('(', Inrec);
  1608.       if posit = 0 then exit;
  1609.  
  1610.       DoorName := copy(Inrec, posit+1, pos(')', Inrec)-posit-1);
  1611.       repeat
  1612.          posit := pos('\',DoorName);
  1613.          if posit > 0 then
  1614.             DoorName := copy(DoorName, posit+1, 99);
  1615.       until posit = 0;
  1616.  
  1617.       inc(DOORs);
  1618.       add_item(FirstDoor, DoorName, 1);
  1619.  
  1620.       if pos('CHAT', Urec) > 0 then
  1621.          inc(nchat);
  1622.    end;
  1623.  
  1624.  
  1625. (* -------------------------------------------------------- *)
  1626. procedure DOSdrop;
  1627.    var
  1628.       DT1, DT2:   integer;
  1629.       a:          integer;
  1630.  
  1631.    begin
  1632.       val(copy(Urec, 34, 2), DT1, a); {exit to DOS time}
  1633.  
  1634.       getrec;
  1635.       val(copy(Urec, 27, 2), DT2, a); {back from DOS time}
  1636.       if a = 0 then 
  1637.       begin
  1638.          DT1 := (DT2-DT1);
  1639.          if DT1 < 0 then DT1 := DT1+60; {adjust for hour rollover}
  1640.          DosTime := DosTime+DT1;
  1641.       end;
  1642.       inc(DosTimes);
  1643.    end;
  1644.  
  1645.  
  1646. (* -------------------------------------------------------- *)
  1647. procedure sysop_chat;
  1648.    var
  1649.       DT1, DT2:   integer;
  1650.       a:          integer;
  1651.       node:       boolean;
  1652.  
  1653.    begin
  1654.       node := (Urec[7] = 'N');
  1655.       val(copy(Urec, 34, 2), DT1, a); {chat started time time}
  1656.  
  1657.       getrec;
  1658.       val(copy(Urec, 27, 2), DT2, a); {chat ended time}
  1659.       if a = 0 then 
  1660.       begin
  1661.          DT1 := (DT2-DT1);
  1662.          if DT1 < 0 then DT1 := DT1+60; {adjust for hour rollover}
  1663.       end;
  1664.  
  1665.       if node then
  1666.          inc(nchat)
  1667.       else
  1668.          inc(schat);
  1669.    end;
  1670.  
  1671.  
  1672. (* -------------------------------------------------------- *)
  1673. procedure system_event;
  1674.    var
  1675.       p: integer;
  1676.    begin
  1677.       p := pos(':',urec);
  1678.       if p > 0 then
  1679.          event_time := copy(urec,p-2,5)
  1680.       else
  1681.          event_time := '';
  1682.       inc(events);
  1683.    end;
  1684.  
  1685.  
  1686. (* -------------------------------------------------------- *)
  1687. procedure mins_used;
  1688.    var
  1689.       a, y, p:  integer;
  1690.       minutoff,
  1691.       houroff,
  1692.       timeused:  integer;
  1693.  
  1694.    begin
  1695.       p := pos(':', Urec)+2;
  1696.       y := p;
  1697.       while (Urec[y] >= '0') and (Urec[y] <= '9') do
  1698.          inc(y);
  1699.       val(copy(Urec, p, y-p), timeused, a);
  1700.  
  1701.       if clevel <> '' then
  1702.       begin
  1703.          add_item(FirstAveMins, clevel, timeused/60.0);
  1704.          clevel := '';
  1705.       end;
  1706.  
  1707.       getrec;
  1708.       val(copy(Urec, 11, 2), houroff, a);
  1709.       if houroff > 23 then
  1710.          houroff := houroff - 24;
  1711.       val(copy(Urec, 14, 2), minutoff, a);
  1712.  
  1713.       while timeused > 0 do
  1714.       begin
  1715.          if timeused > minutoff then
  1716.             a := minutoff
  1717.          else
  1718.             a := timeused;
  1719.  
  1720.          UsedMinutes := UsedMinutes + a;
  1721.          while UsedMinutes > 60 do
  1722.          begin
  1723.             inc(Hours);
  1724.             UsedMinutes := UsedMinutes - 60;
  1725.          end;
  1726.  
  1727.          Hrs[houroff] := Hrs[houroff]+a;
  1728.          timeused := timeused-a;
  1729.  
  1730.          if houroff > 0 then
  1731.             dec(houroff)
  1732.          else
  1733.             houroff := 23;
  1734.          minutoff := 60;
  1735.       end;
  1736.    end;
  1737.  
  1738.  
  1739. (* -------------------------------------------------------- *)
  1740. procedure catchall;
  1741.    begin
  1742.       if pos(' CHAT ', Urec)              > 0 then sysop_chat
  1743.       else if pos('LIVECHAT', Urec)       > 0 then inc(nchat)
  1744.       else if pos('SCHEDULED', Urec)      > 0 then system_event
  1745.       else if pos('OPENED DOOR ', Urec)   > 0 then pdoors
  1746.       else if pos('OINED', Urec)          > 0 then confjoin
  1747.       else if pos('MINUTES USED', Urec)   > 0 then mins_used
  1748.       else if pos('ACCESS DENIED', Urec)  > 0 then inc(tcan)
  1749.       else if pos('COMMENT ', Urec)       > 0 then inc(comments)
  1750.       else if pos('NOT REGISTERED', Urec) > 0 then inc(secviol)
  1751.       else if pos('OCK-', Urec)           > 0 then inc(lockouts)
  1752.       else if pos('PAGED', Urec)          > 0 then inc(sysop_paged)
  1753.       else if pos('QUESTIONNAIRE ', Urec) > 0 then inc(question)
  1754.       else if pos('REFUSED', Urec)        > 0 then inc(refused)
  1755.       else if pos('TIME LIMIT', Urec)     > 0 then inc(time_limit)
  1756.       else if pos('VIOLATION', Urec)      > 0 then inc(secviol)
  1757.       else if pos('LEFT:', Urec)          > 0 then inc(mssgs)
  1758.    end;
  1759.  
  1760.  
  1761. (* -------------------------------------------------------- *)
  1762. procedure scanrec;
  1763.    begin
  1764.  
  1765.       if Urec[1] <> ' ' then
  1766.          incaller
  1767.       else
  1768.  
  1769.       case Urec[7] of
  1770.          '*' :;
  1771.  
  1772.          '(':  if Urec[9] <> ')' then inc(stuff)
  1773.                else if Urec[8] = 'D' then indownload
  1774.                else if Urec[8] = 'U' then indownload
  1775.                else catchall;
  1776.  
  1777.          'A':  if pos('ACCESS DENIED', Urec)       > 0 then inc(tcan)
  1778.                else catchall;
  1779.  
  1780.          'B':  if pos('BULLETIN READ:', Urec)      > 0 then bulletins
  1781.                else if pos('BACK FROM DOS', Urec)  > 0 then inc(backdos)
  1782.                else catchall;
  1783.  
  1784.          'C':  if pos('COMMENT ', Urec)            > 0 then inc(comments)
  1785.                else if pos('CALLER EXITED ', Urec) > 0 then DOSdrop
  1786.                else if pos('CONNECT TYPE:',Urec)   > 0 then con_type
  1787.                else if pos('CALLER SECURITY',Urec) > 0 then sec_level
  1788.                else catchall;
  1789.  
  1790.          'D':  if pos('DIRECTORY SCAN ', Urec)     > 0 then inc(dirscan)
  1791.                else catchall;
  1792.  
  1793.          'E':  if pos('EXTRACT M', Urec)           > 0 then inc(extmember)
  1794.                else catchall;
  1795.  
  1796.          'F':  if pos('FILE (', Urec)              > 0 then inc(stuff)
  1797.                else if pos('FREE DOWNLOAD', Urec)  > 0 then pfree_down
  1798.                else catchall;
  1799.  
  1800.          'K':  if pos('KEYBOARD TIME',Urec)        > 0 then inc(stuff)
  1801.                else catchall;
  1802.  
  1803.          'I':  if pos('INSUFFICIENT ',Urec)        > 0 then inc(secviol)
  1804.                else if pos('INVALID ARC',Urec)     > 0 then inc(invalids)
  1805.                else if pos('INVALID ZIP',Urec)     > 0 then inc(invalids)
  1806.                else if pos('INVALID FIL',Urec)     > 0 then inc(invalids)
  1807.                else catchall;
  1808.  
  1809.          'M':  if pos('LEFT:', Urec)               > 0 then
  1810.                begin
  1811.                   inc(mssgs);
  1812.                   if pos('VIA QMAIL', Urec) > 0 then
  1813.                      inc(Qmssgs);
  1814.                   if pos('THRU MARKM', Urec) > 0 then
  1815.                      inc(Mmssgs);
  1816.                end
  1817.                else if pos('KILLED:', Urec)        > 0 then inc(kills)
  1818.                else if pos('MINUTES USED', Urec)   > 0 then mins_used
  1819.                else catchall;
  1820.  
  1821.          'N':  if pos('NODE CHAT ENT', Urec)       > 0 then sysop_chat
  1822.                else if pos('NODE CHAT END', Urec)  > 0 then inc(stuff)
  1823.                else catchall;
  1824.  
  1825.          'O':  if pos('OPERATOR', Urec)            > 0 then inc(sysop_paged)
  1826.                else if pos('OPENED DOOR ', Urec)   > 0 then pdoors
  1827.                else catchall;
  1828.  
  1829.          'P':  if pos('PASSWORD FAILURE', Urec)    > 0 then inc(pwfail)
  1830.                else catchall;
  1831.  
  1832.          'R':  if pos('REFUSED', Urec)             > 0 then inc(refused)
  1833.                else if pos('REGISTRATION', Urec)   > 0 then inc(new_guys)
  1834.                else if pos('REPACK ', Urec)        > 0 then inc(repacks)
  1835.                else if pos('REQUEST LIBRARY',Urec) > 0 then inc(libdisk)
  1836.                else catchall;
  1837.  
  1838.          'S':  if pos('SCHEDULED', Urec)           > 0 then system_event
  1839.                else if pos('SORRY', Urec)          > 0 then inc(secviol)
  1840.                else if pos('SYSOP CHAT A', Urec)   > 0 then sysop_chat
  1841.                else if pos('SYSOP CHAT E', Urec)   > 0 then inc(stuff)
  1842.                else if pos('SECURITY LEVEL:',Urec) > 0 then sec_level
  1843.                else catchall;
  1844.  
  1845.          'T':  if pos('TIME LIMIT', Urec)          > 0 then inc(time_limit)
  1846.                else if pos('REGISTRATION', Urec)   > 0 then inc(new_guys)
  1847.                else if pos('TEST EXECUTED', Urec)  > 0 then inc(testexec)
  1848.                else if pos('THANKS, ', Urec)       > 0 then inc(secviol)
  1849.                else catchall;
  1850.  
  1851.          'V':  if pos('VIEW E', Urec)              = 7 then inc(viewexec)
  1852.                else if pos('VIEW M', Urec)         = 7 then inc(viewmember)
  1853.                else catchall;
  1854.  
  1855.          'Z':  if pos('ZIPM EXE', Urec)            > 0 then inc(zipmail)
  1856.                else catchall;
  1857.  
  1858.          '0'..'9':
  1859.                if pos(' FILES,',Urec)              > 0 then batch
  1860.                else if pos(' MESSAGES ',Urec)      > 0 then zipmsgs
  1861.                else catchall;
  1862.          else
  1863.                catchall;
  1864.       end;
  1865.    end;
  1866.  
  1867.  
  1868. (* -------------------------------------------------------- *)
  1869. function rec_time(rec: anystring): anystring;
  1870. var
  1871.    temp: anystring;
  1872.  
  1873. begin      {12345678901234}
  1874.            {yy-mm-dd hh:mm};
  1875.    temp := '00-00-00 00:00';
  1876.  
  1877.    if length(rec) > 15 then
  1878.    begin
  1879.       temp[1] := rec[7];
  1880.       temp[2] := rec[8];
  1881.  
  1882.       temp[4] := rec[1];
  1883.       temp[5] := rec[2];
  1884.  
  1885.       temp[7] := rec[4];
  1886.       temp[8] := rec[5];
  1887.  
  1888.       temp[10] := rec[11];
  1889.       temp[11] := rec[12];
  1890.       temp[13] := rec[14];
  1891.       temp[14] := rec[15];
  1892.    end;
  1893.  
  1894.    rec_time := temp;
  1895. end;
  1896.  
  1897.  
  1898. (* -------------------------------------------------------- *)
  1899. procedure jdate(rec: string; var dt: real);
  1900. var
  1901.    a,mostr,daystr,yrstr:   word;
  1902.    frac:                   real;
  1903.    days:                   real;
  1904.    hours:                  real;
  1905.  
  1906. begin
  1907.    {12345678901234}
  1908.    {yy-mm-dd hh:mm}
  1909.  
  1910.    val( copy(rec, 4, 2), mostr, a);   {get month}
  1911.    days := finday(mostr);
  1912.  
  1913.    val(copy(rec, 7, 2), daystr, a);   {get day}
  1914.  
  1915.    val(rec[2], YrStr, a);             {last digit of year}
  1916.    if YrStr < 8 then
  1917.       inc(YrStr,10);
  1918.  
  1919.    val(copy(rec, 10, 2), hours, a);   {hour digit of logon}
  1920.    if hours > 23 then
  1921.       hours := hours - 24;
  1922.  
  1923.    val(copy(rec, 13, 2), frac, a);
  1924.    frac := frac/60;
  1925.  
  1926.    dt := hours + (yrstr*365+days+daystr) * 24 + frac;
  1927. end;
  1928.  
  1929.  
  1930. (* -------------------------------------------------------- *)
  1931. procedure scanfile(node: integer);
  1932.    var
  1933.       tx1:     string[20];
  1934.       tx:      anystring;
  1935.       nrec:    word;
  1936.  
  1937.    begin
  1938.       nrec := 0;
  1939.  
  1940.       while not eof(ifd) do
  1941.       begin
  1942.          scanrec;
  1943.  
  1944.          inc(nrec);
  1945.          if (nrec mod 50) = 1 then
  1946.          begin
  1947.             str((int(nrec)/int(logsize)*100.0):  5:  1, tx1);
  1948.             tx1 := 'Working ... '+tx1+' %';
  1949.             print(2, 17, tx1, ansicrt.lightred);
  1950.          end;
  1951.  
  1952.          getrec;
  1953.       end;
  1954.  
  1955.       close(ifd);
  1956.  
  1957.       tx1 := 'Working ... 100.0 %';
  1958.       print(2, 17, tx1, ansicrt.cyan);
  1959.  
  1960.       if rec_time(last_rec_seen) > rec_time(last_rec) then
  1961.          last_rec := last_rec_seen;
  1962.       last_entry := rec_time(last_rec);
  1963.       print(2, 23, 'Last log entry:  '+last_rec, ansicrt.lightgreen);
  1964.       jdate(last_entry,end_hours);
  1965.  
  1966.       {determine the period involved}
  1967.       PeriodCovered := 'Period covered:  From '+first_entry+' to '+last_entry;
  1968.       print(2, 21, PeriodCovered, ansicrt.lightmagenta);
  1969.  
  1970.       if node = nodes then
  1971.       begin
  1972.          TotHours := (end_hours-beg_hours) * nodes;
  1973.          str(TotHours:  5:  1, TX);
  1974.          TX := concat('Total Hours of Operation: ', TX);
  1975.          print(2, 19, TX, ansicrt.white);
  1976.       end;
  1977.    end;
  1978.  
  1979.  
  1980. (* -------------------------------------------------------- *)
  1981. procedure openfiles(node: integer);
  1982.    var
  1983.       TX:   string[62];
  1984.       name: anystring;
  1985.       a:    integer;
  1986.       fd:   dos_handle;
  1987.  
  1988.    begin
  1989.       stoupper(inName);
  1990.       if (node > 0) and (inName <> 'NUL') then
  1991.          TX := itoa(node)
  1992.       else
  1993.          TX := '';
  1994.       name := InName + TX;
  1995.  
  1996.       if name <> 'NUL' then
  1997.          print(1,1,'Reading '+name+' ...',ansicrt.white);
  1998.       clreol;
  1999.  
  2000.       fd := dos_open(name,open_read);
  2001.       if ioresult = dos_error then
  2002.       begin
  2003.          writeln('Cant open caller file: ',name);
  2004.          halt(1);
  2005.       end;
  2006.  
  2007.       dos_lseek(fd,0,seek_end);
  2008.       logsize := dos_tell div 64;
  2009.       dos_close(fd);
  2010.  
  2011.       TX := 'Total Records in the Callers file: '+wtoa(logsize);
  2012.       print(2, 20, TX, ansicrt.yellow);
  2013.  
  2014.       assignText(ifd,name);
  2015.       {$i-} reset(ifd); {$i+}
  2016.       if ioresult <> 0 then
  2017.       begin
  2018.          writeln('Cant open caller file: ',name);
  2019.          halt(1);
  2020.       end;
  2021.  
  2022.       SetTextbuf(ifd,iobuf);
  2023.  
  2024.       {decode the beginning of the logfile}
  2025.       repeat
  2026.          getrec;
  2027.       until (Urec[3] = '-') or eof(ifd);
  2028.  
  2029.       if (not eof(ifd)) then
  2030.          if (first_rec = '') or (rec_time(first_rec) > rec_time(Urec)) then
  2031.             first_rec := Urec;
  2032.  
  2033.       first_entry := rec_time(first_rec);
  2034.       print(2, 22, 'First log entry: '+first_rec, ansicrt.lightgreen);
  2035.  
  2036.       jdate(first_entry,beg_hours);
  2037.    end;
  2038.  
  2039.  
  2040.  
  2041. (* -------------------------------------------------------- *)
  2042. var
  2043.    line: string;
  2044.    xfd: text;
  2045.  
  2046. procedure write_list(node: ItemPointer);
  2047. begin
  2048.    while node <> nil do
  2049.    begin
  2050.       writeln(xfd,node^.name);
  2051.       writeln(xfd,node^.count);
  2052.       node := node^.next;
  2053.    end;
  2054.    writeln(xfd);
  2055. end;
  2056.  
  2057.  
  2058. (* -------------------------------------------------------- *)
  2059. procedure write_tree(node: FilePointer);
  2060. begin
  2061.    if node = nil then
  2062.       writeln(xfd)
  2063.    else
  2064.    begin
  2065.       writeln(xfd,node^.name);
  2066.       writeln(xfd,node^.size,' ',node^.count);
  2067.       write_tree(node^.higher);
  2068.       write_tree(node^.lower);
  2069.    end;
  2070. end;
  2071.  
  2072.  
  2073. (* -------------------------------------------------------- *)
  2074. procedure read_list(var node: ItemPointer);
  2075. var
  2076.    add:  ItemPointer;
  2077.  
  2078. begin
  2079.    {special case - empty list}
  2080.    Qreadln(xfd,line,sizeof(line));
  2081.    repeat
  2082.       if length(line) = 0 then
  2083.       begin
  2084.          node := nil;
  2085.          exit;
  2086.       end;
  2087.       if line[1] = ' ' then
  2088.          delete(line,1,1);
  2089.    until line[1] <> ' ';
  2090.  
  2091.    {insert head of list}
  2092.    new(node);
  2093.    add := node;
  2094.    add^.name := line;
  2095.    readln(xfd,add^.count);
  2096.  
  2097.    {add rest of the list}
  2098.    Qreadln(xfd,line,sizeof(line));
  2099.    while length(line) <> 0 do
  2100.    begin
  2101.       new(add^.next);
  2102.       add := add^.next;
  2103.       add^.name := line;
  2104.       readln(xfd,add^.count);
  2105.  
  2106.       Qreadln(xfd,line,sizeof(line));
  2107.    end;
  2108.  
  2109.    add^.next := nil;
  2110. end;
  2111.  
  2112.  
  2113. (* -------------------------------------------------------- *)
  2114. procedure read_tree(var node: FilePointer);
  2115. begin
  2116.    Qreadln(xfd,line,sizeof(line));
  2117.    if length(line)=0 then
  2118.       node := nil
  2119.    else
  2120.    begin
  2121.       new(node);
  2122.       node^.name := line;
  2123.       read(xfd,node^.size);
  2124.       readln(xfd,node^.count);
  2125.       read_tree(node^.higher);
  2126.       read_tree(node^.lower);
  2127.    end;
  2128. end;
  2129.  
  2130.  
  2131. (* -------------------------------------------------------- *)
  2132. procedure save_state;
  2133. var
  2134.    i: integer;
  2135.  
  2136. begin
  2137.    stoupper(saveFile);
  2138.    if saveFile = 'NUL' then
  2139.       exit;
  2140.  
  2141.    print(1,1,'Writing '+saveFile+' ...',ansicrt.white);
  2142.    clreol;
  2143.  
  2144.    assign(xfd,saveFile);
  2145.    rewrite(xfd);
  2146.    SetTextbuf(xfd,iobuf);
  2147.  
  2148.    writeln(xfd,'-7');
  2149.  
  2150.    writeln(xfd,spare1);
  2151.    writeln(xfd,spare2);
  2152.    writeln(xfd,spare3);
  2153.    writeln(xfd,spare4);
  2154.    writeln(xfd,event_mins);
  2155.    writeln(xfd,event_time);
  2156.  
  2157.    writeln(xfd,copy(last_rec,1,62));
  2158.  
  2159.    writeln(xfd,
  2160.            Qmssgs,' ',
  2161.            libdisk,' ',
  2162.            spare13);
  2163.  
  2164.    writeln(xfd,
  2165.            zipmail,' ',
  2166.            msgcount,' ',
  2167.            invalids,' ',
  2168.            spare6,' ',
  2169.            spare7,' ',
  2170.            spare8,' ',
  2171.            nchat,' ',
  2172.            spare9,' ',
  2173.            testexec,' ',
  2174.            free_down);
  2175.  
  2176.    writeln(xfd,
  2177.            viewexec,' ',
  2178.            spare15,' ',
  2179.            spare11,' ',
  2180.            spare14,' ',
  2181.            spare16,' ',
  2182.            spare12,' ',
  2183.            backdos,' ',
  2184.            batchs);
  2185.  
  2186.    writeln(xfd,
  2187.            Mmssgs,' ',
  2188.            blts,' ',
  2189.            caller,' ',
  2190.            schat,' ',
  2191.            comments,' ',
  2192.            dirscan,' ',
  2193.            DOORs,' ',
  2194.            DosTime);
  2195.  
  2196.    writeln(xfd,
  2197.            DosTimes,' ',
  2198.            down,' ',
  2199.            d_abort,' ',
  2200.            events,' ',
  2201.            even_parity,' ',
  2202.            extmember,' ',
  2203.            graphics,' ',
  2204.            Hours);
  2205.  
  2206.    writeln(xfd,
  2207.            joins,' ',
  2208.            kills,' ',
  2209.            lockouts,' ',
  2210.            UsedMinutes,' ',
  2211.            mssgs,' ',
  2212.            new_guys,' ',
  2213.            non_graphics,' ',
  2214.            sysop_paged);
  2215.  
  2216.    writeln(xfd,
  2217.            pwfail,' ',
  2218.            question,' ',
  2219.            repacks,' ',
  2220.            refused,' ',
  2221.            secviol,' ',
  2222.            stuff,' ',
  2223.            sysop_local,' ',
  2224.            sysop_remote);
  2225.  
  2226.    writeln(xfd,
  2227.            tcan,' ',
  2228.            time_limit,' ',
  2229.            TotHours:0:2,' ',
  2230.            UniqFiles,' ',
  2231.            up,' ',
  2232.            u_abort,' ',
  2233.            viewmember);
  2234.  
  2235.    writeln(xfd,copy(first_rec,1,62));
  2236.  
  2237.    for i := 1 to ProtocolCount do
  2238.    with Protocol[i] do
  2239.       writeln(xfd,
  2240.                  code,' ',
  2241.                  Uploads,' ',
  2242.                  UpTime:0:2,' ',
  2243.                  UpIdeal:0:2,' ',
  2244.                  Downloads,' ',
  2245.                  DownTime:0:2,' ',
  2246.                  DownIdeal:0:2);
  2247.  
  2248.    for i := 0 to 23 do
  2249.       writeln(xfd,Hrs[i]);
  2250.  
  2251.    write_list(FirstAvemins);
  2252.    write_list(FirstSpare3);
  2253.    write_list(FirstSpare4);
  2254.    write_list(FirstSpare5);
  2255.    write_list(FirstSpare6);
  2256.    write_list(FirstSpare7);
  2257.    write_list(FirstSpare8);
  2258.  
  2259.    write_list(FirstFreeDL);
  2260.    write_list(FirstConType);
  2261.    write_list(FirstSecLevel);
  2262.    write_list(FirstBaud);
  2263.    write_list(FirstBatch);
  2264.    write_list(FirstBullet);
  2265.    write_list(FirstConf);
  2266.    write_list(FirstDoor);
  2267.  
  2268.    write_tree(FileTree);
  2269.  
  2270.    close(xfd);
  2271. end;
  2272.  
  2273.  
  2274. (* -------------------------------------------------------- *)
  2275. procedure load_state;
  2276. var
  2277.    i: integer;
  2278.    n: integer;
  2279.    c: char;
  2280.  
  2281. begin
  2282.    assign(xfd,saveFile);
  2283.    {$i-} reset(xfd); {$i+}
  2284.    if ioresult <> 0 then
  2285.       exit;
  2286.  
  2287.    SetTextbuf(xfd,iobuf);
  2288.    print(1,1,'Loading '+saveFile+' ...',ansicrt.white);
  2289.    clreol;
  2290.  
  2291.    read(xfd,filever);
  2292.    if (filever <> -6) and (filever <> -7) then
  2293.    begin
  2294.       writeln('Can''t use your old ',saveFile,' file!  Will create a new one.');
  2295.       close(xfd);
  2296.       exit;
  2297.    end;
  2298.  
  2299.    readln(xfd, spare1);
  2300.    readln(xfd, spare2);
  2301.    readln(xfd, spare3);
  2302.    readln(xfd, spare4);
  2303.    readln(xfd, event_mins);
  2304.    readln(xfd, event_time);
  2305.  
  2306.    Qreadln(xfd,last_rec,sizeof(last_rec));
  2307.  
  2308.    read(xfd, Qmssgs, libdisk, spare13, zipmail, msgcount, invalids,
  2309.            spare6, spare7, spare8, nchat, spare9, testexec, free_down,
  2310.            viewexec, spare15, spare11, spare14, spare16, spare12,
  2311.            backdos, batchs, Mmssgs, blts, caller, schat, comments,
  2312.            dirscan, DOORs, DosTime, DosTimes, down, d_abort, events,
  2313.            even_parity, extmember, graphics, Hours, joins, kills,
  2314.            lockouts, UsedMinutes, mssgs, new_guys, non_graphics,
  2315.            sysop_paged, pwfail, question, repacks, refused, secviol,
  2316.            stuff, sysop_local, sysop_remote, tcan, time_limit, TotHours,
  2317.            UniqFiles, up, u_abort);
  2318.  
  2319.    readln(xfd, viewmember);
  2320.  
  2321.    Qreadln(xfd,first_rec,sizeof(first_rec));
  2322.  
  2323.    if filever = -6 then
  2324.       n := OldProtocolCount
  2325.    else
  2326.       n := ProtocolCount;
  2327.    for i := 1 to n do
  2328.    with Protocol[i] do
  2329.       readln(xfd, code, Uploads, UpTime, UpIdeal,
  2330.                         Downloads, DownTime, DownIdeal);
  2331.  
  2332.    for i := 0 to 23 do
  2333.       readln(xfd,Hrs[i]);
  2334.  
  2335.    read_list(FirstAvemins);
  2336.  
  2337.    read_list(FirstSpare3);
  2338.    read_list(FirstSpare4);
  2339.    read_list(FirstSpare5);
  2340.    read_list(FirstSpare6);
  2341.    read_list(FirstSpare7);
  2342.    read_list(FirstSpare8);
  2343.  
  2344.    read_list(FirstFreeDL);
  2345.    read_list(FirstConType);
  2346.    read_list(FirstSecLevel);
  2347.  
  2348.    read_list(FirstBaud);
  2349.    read_list(FirstBatch);
  2350.    read_list(FirstBullet);
  2351.    read_list(FirstConf);
  2352.    read_list(FirstDoor);
  2353.  
  2354.    read_tree(FileTree);
  2355.  
  2356.    close(xfd);
  2357.  
  2358.    write(^M);
  2359.    clreol;
  2360. end;
  2361.  
  2362.  
  2363. (* -------------------------------------------------------- *)
  2364. procedure usage;
  2365. begin
  2366.    writeln('Usage:   calls CONFIG_FILE');
  2367.    writeln('Example: calls calls.cnf');
  2368.    halt;
  2369. end;
  2370.  
  2371.  
  2372. (* -------------------------------------------------------- *)
  2373. procedure clean(var s: anystring);
  2374. begin
  2375.    while s[length(s)] = ' ' do
  2376.       dec(s[0]);         {skip trailing blanks}
  2377.    while copy(s,1,1) = ' ' do
  2378.       delete(s,1,1);     {skip leading blanks}
  2379. end;
  2380.  
  2381.  
  2382. (* -------------------------------------------------------- *)
  2383. procedure define_protocol(par: anystring);
  2384. var
  2385.    k: integer;
  2386. begin
  2387.       for k := 1 to ProtocolCount do
  2388.       with Protocol[k] do
  2389.          if (Code = par[1]) then
  2390.             name := copy(par,3,255);
  2391. end;
  2392.  
  2393.  
  2394. (* -------------------------------------------------------- *)
  2395. procedure set_event_mode(par: anystring);
  2396. begin
  2397.    if (par = 'OFF') or (par = 'BUSY') or (par = 'IDLE') then
  2398.       event_mode := par
  2399.    else
  2400.    begin
  2401.       writeln('Invalid EVENTMODE parameter: ',par);
  2402.       writeln('Must be one of:  OFF BUSY IDLE');
  2403.       halt(1);
  2404.    end;
  2405. end;
  2406.  
  2407.  
  2408. (* -------------------------------------------------------- *)
  2409. procedure load_configuration;
  2410. var
  2411.    fd:   text;
  2412.    cmd:  anystring;
  2413.    par:  anystring;
  2414.    p:    integer;
  2415.  
  2416. begin
  2417.    if paramcount < 1 then
  2418.       usage;
  2419.  
  2420.    assignText(fd,paramstr(1));
  2421.    {$i-} reset(fd); {$i+}
  2422.    if ioresult <> 0 then
  2423.    begin
  2424.       writeln('Can''t open config file: ',paramstr(1));
  2425.       halt;
  2426.    end;
  2427.  
  2428.    while not eof(fd) do
  2429.    begin
  2430.       readln(fd,cmd);
  2431.  
  2432.       p := pos(';',cmd);      {skip       ;comments}
  2433.       if p > 0 then
  2434.          cmd[0] := chr(p-1);
  2435.  
  2436.       clean(cmd);
  2437.  
  2438.       p := pos(' ',cmd);
  2439.       if p = 0 then
  2440.          par := ''
  2441.       else
  2442.       begin
  2443.          par := copy(cmd,p+1,255);
  2444.          cmd[0] := chr(p-1);
  2445.          clean(cmd);
  2446.          clean(par);
  2447.       end;
  2448.  
  2449.       stoupper(cmd);
  2450.  
  2451.       if (cmd = 'INFILE')        then  inName := par
  2452.  
  2453.       else if (cmd = 'OUTFILE')  then  outFile := par
  2454.  
  2455.       else if (cmd = 'SAVEFILE') then  saveFile := par
  2456.  
  2457.       else if (cmd = 'SUBTITLE') then  subTitle := par
  2458.  
  2459.       else if (cmd = 'NODES')    then  val(par,nodes,p)
  2460.  
  2461.       else if (cmd = 'REPORTS')  then  reports := par
  2462.  
  2463.       else if (cmd = 'MINDL')    then  val(par,min_download,p)
  2464.  
  2465.       else if (cmd = 'PEAK')     then  PeakTable := par
  2466.  
  2467.       else if (cmd = 'MAXCONF')  then  val(par,maxConf,p)
  2468.  
  2469.       else if (cmd = 'MAXBLT')   then  val(par,maxBlt,p)
  2470.  
  2471.       else if (cmd = 'MAXDOOR')  then  val(par,maxDoor,p)
  2472.  
  2473.       else if (cmd = 'MAXBATCH') then  val(par,maxBatch,p)
  2474.  
  2475.       else if (cmd = 'MAXFREE')  then  val(par,maxFree,p)
  2476.  
  2477.       else if (cmd = 'PROTOCOL') then  define_protocol(par)
  2478.  
  2479.       else if (cmd = 'EVENTMODE') then set_event_mode(par)
  2480.  
  2481.       else if (cmd <> '') then
  2482.       begin
  2483.          writeln('Invalid config keyword: ',cmd,' ',par);
  2484.          writeln;
  2485.          writeln('Each config line must start with one of these words:');
  2486.          writeln('   INFILE OUTFILE SAVEFILE NODES REPORTS MINDL PEAK');
  2487.          writeln('   MAXCONF MAXBLT MAXDOOR MAXBATCH PROTOCOL EVENTMODE');
  2488.          halt(1);
  2489.       end;
  2490.    end;
  2491.  
  2492.    stoupper(inName);
  2493.    close(fd);
  2494. end;
  2495.  
  2496.  
  2497. (* -------------------------------------------------------- *)
  2498. procedure init;            {initialize}
  2499.    begin
  2500.       runtime := 0;
  2501.       start_time := Time;
  2502.  
  2503.       load_configuration;
  2504.  
  2505.       clrscr;
  2506.       print(13,  5, '╔═════════════════════════════════════════════════════╗', lightred);
  2507.       print(13,  6, '║                                                     ║', lightred);
  2508.       print(13,  7, '║                                                     ║', lightred);
  2509.       print(13,  8, '║                                                     ║', lightred);
  2510.       print(13,  9, '║                                                     ║', lightred);
  2511.       print(13, 10, '║                                                     ║', lightred);
  2512.       print(13, 11, '║                                                     ║', lightred);
  2513.       print(13, 12, '║                                                     ║', lightred);
  2514.       print(13, 13, '║                                                     ║', lightred);
  2515.       print(13, 14, '║                                                     ║', lightred);
  2516.       print(13, 15, '╚═════════════════════════════════════════════════════╝', lightred);
  2517.  
  2518.       print(32, 7, pcbversion, lightgreen);
  2519.       print(25, 9,  '     Calls v'+version+', '+reldate, lightgreen);
  2520.       print(25, 10, '     (c) 1987  Warren Lauzon', lightcyan);
  2521.       print(25, 12, '   Modified by Samuel H. Smith',ansicrt.white );
  2522.       gotoxy(1,1);
  2523.    end;
  2524.  
  2525.  
  2526. (* -------------------------------------------------------- *)
  2527. var
  2528.    node: integer;
  2529.  
  2530. begin
  2531.    init;
  2532.    load_state;
  2533.  
  2534.    if nodes = 1 then
  2535.    begin
  2536.       openfiles(0);
  2537.       scanfile(1);
  2538.    end
  2539.    else
  2540.  
  2541.    for node := 1 to nodes do
  2542.    begin
  2543.       openfiles(node);
  2544.       scanfile(node);
  2545.    end;
  2546.  
  2547.    Endtime := Time;
  2548.    runtime := Endtime-start_time;
  2549.  
  2550.    gotoxy(30, 17);
  2551.    writeln('Elapsed Time:  ', runtime:  6:  1);
  2552.  
  2553.    output_results(outfile+'G');
  2554.  
  2555.    {disable colors and repeat for non-g file}
  2556.    red := '';
  2557.    green := '';
  2558.    yellow := '';
  2559.    blue := '';
  2560.    magenta := '';
  2561.    cyan := '';
  2562.    white := '';
  2563.    gray := '';
  2564.    output_results(outfile);
  2565.  
  2566.    save_state;
  2567.    gotoxy(1, 25);
  2568.    textcolor(LightGray);
  2569. end.
  2570.  
  2571.